COMMENT ⊗   VALID 00030 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	TITLE XIP - XEROX IMMEDIATE DOCUMENT PRINTER - BGB - 24 MARCH 1974.
C00009 00003	START ADDRESS ENTRY.
C00012 00004	TEXT BUFFER SPECIFICATIONS.
C00014 00005	XGP RASTER SPECIFICATIONS.
C00017 00006	TWO DIMENSION BIT ADDRESSING.
C00020 00007	SUBR(XGPOUT)	OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
C00023 00008	SUBR(EOPAGE)
C00025 00009	SUBR(PRINT)	PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00028 00010	SUBR(GETCHR)	GET A NON-NULL CHARACTER FROM THE TEXT BUFFER.
C00030 00011	SUBR(GETFIL)	GET FILE SPECIFICATION - SKIP OK.
C00032 00012	FONT SPECIFICATION.
C00038 00013	ASCII JUMP TABLE.
C00042 00014	TEXT JUSTFICATION MODES.
C00049 00015	SUBR(JUSTIFY)	PRINT A JUSTIFIED PARAGRAPH OF TEXT.
C00052 00016	SUBR(LNSCAN)	LINE SCAN FOR SPACES COUNT.
C00055 00017	SUBR(LNJUST)	LINE JUSTIFY AND PRINT.
C00058 00018	SUBR(TJLINE)	CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
C00060 00019	FONT SELECT DELIMITERS.
C00062 00020	SUBR(MKSEG0)	MAKE LINE SEGMENT.
C00065 00021	SUBR(MKSEG1)		MAKE HEAVY LINES.
C00069 00022	SUBR(IIISIM)	OUTPUT III BUFFER ONTO XGP.
C00072 00023		EXECUTE III TEXT.
C00075 00024		EXECUTE VECTORS.
C00078 00025	SUBR(VIDEO)
C00082 00026	SUBR(INFILE)	INDIRECT FILE COMMAND "@".
C00085 00027	COMMAND EXECUTION.
C00090 00028	SUBR(SQRT,X)
C00093 00029	SUBR(REALIN)
C00096 00030	SUBR(DPYDOT,X,Y)	DISPLAY A DOT.
C00103 ENDMK
C⊗;
TITLE XIP - XEROX IMMEDIATE DOCUMENT PRINTER - BGB - 24 MARCH 1974.

;ALTERNATE PDP-10 MNEMONICS.
	OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]
	OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
	OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]
	OPDEF DZM[SETZM]↔OPDEF GO[JRST]
	OPDEF FLOAT[FSC 233]↔OPDEF FIXX[FIX 233000]

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
	↓P←←17
	DEFINE POP0J<POPJ P,>
	↓POP1J.:↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
	↓POP4J.:↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
	DEFINE ACCUMULATORS(LIST){ACPTR←←2	;DECLARE ACCUMULATORS.
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	FOR @$ I←0,16<AC.$I←I↔>		;ACCUMULATOR NAMES FOR RAID.
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM:0↔>}

;MACROS TO SAVE AND RESTORE AC'S  -  SAVAC, GETAC.
	DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
	DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}

;FATAL ERROR MESSAGE.
	DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
	FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
	OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
	%←←400000

;SAIL LIKE SUBROUTINE LINKAGE.
	DEFINE CAT $(A,B){A$B}	;CONCATENATION.
	.PLEVEL←←0	;PDL BACK POINTER.
	.SLEVEL←←0	;DEPTH OF NESTED SUBROUTINE DECLARATIONS.

;SUBROUTINE DECLARATION MACROS  -  SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
	DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
	↓NAME:;}

;DEFINE ARGUMENT NAME MACRO.
	DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
	DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }

;SUBROUTINE CALLING MACROS  -  CALL & SETQ.
	DEFINE CALL(NAME,X1,X2,X3,X4,X5)
	{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
	IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
	IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
	IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
	IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
	IFDIF<><NAME>{PUSHJ P,NAME }
	.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;STACK ACCESSING MACROS  -  PUSHP & POPP.
	DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
	DEFINE POPP(ARG) {POP  P,ARG↔.PLEVEL←←.PLEVEL-1}
;START ADDRESS ENTRY.
PDL:	BLOCK 100
SA:	CALLI↔LAC P,[IOWD 100,PDL]
	SETOM CMODE			;COMMAND MODE.
	LAC[XWD FONTAB,FONTAB+1]	;CLEAR FONT CORE ADDRESSES.
	DZM FONTAB↔BLT FNTPPN-1
	LAC[SIXBIT/LPTFNT/]		;INPUT DEFAULT FONT.
	HLLZM FILNAM↔HRLZM EXTION
	LAC FNTPPN↔DAC PPPN
	MOVEI 1↔DAC FONT		;FONT NUMERAL 1.
	CALL(<DEFONT+1>)
	CALL(MKXBUF)			;MAKE XGP BUFFER,
	CALL(MKTABL)			;MAKE XGP 2-D ADDRESS TABLE.
	CALL(COMSCAN)			;COMMAND LINE SCAN.
	DZM EOF				;END OF FILE, END OF PAGE.
	CALL(MAIN)			;MAIN TEXT SCANNER.
	EXIT

SUBR(MAIN)	;MAIN CHARACTER SCANNER.
COMMENT .-----------------------------------------------------------.
L0:	LAC ROWMIN↔DAC ROW
	LAC COLMIN↔DAC COL↔DZM EOP
L1:	SKIPE EOP↔GO L3			;END OF PAGE ?
	CALL(GETCHR)			;FETCH A CHARACTER.
	SKIPE EOF↔GO L3			;END OF FILE ?
	SKIPE CMODE↔GO[SETZ		;TEXT OR COMMAND MODE ?
	  CAIGE 1,140↔CDR A00(1)	;COMMAND MODE CHARACTER.
	  SKIPE↔PUSHJ P,@0↔GO L1]	;EXECUTE A COMMAND.
	CAILE 1,137↔GO L2
	CAR 0,A00(1)↔TRZ %↔JUMPE 0,L2	;TEXT MODE CHARACTER.
	CALL(@0)↔GO L1			;TEXT MODE SUBROUTINES.
L2:	CALL(PRINT)↔GO L1		;PRINT UNJUSTIFIED CHARACTER.
L3:  	CALL(XGPOUT)			;OUTPUT XGP PAGE BUFFER.
	SKIPN EOF↔GO L0↔POP0J
ENDR MAIN;-----------------------------------------------------------
	CMODE:	0	;-1 COMMAND MODE.   0 TEXT MODE.
	ESC:	32	;ESCAPE CHARACTER - DEFAULT TILDE.
	XLINE:	5	;EXTRA LINES BETWEEN ROWS OF CHARACTERS
	EOP:0		;END OF PAGE FLAG.
;TEXT BUFFER SPECIFICATIONS.

	CHRCNT:	0	;NUMBER OF CHARACTERS REMAINING.
	TXTPTR:	0	;CURRENT TEXT POINTER.
	TXTORG:	0	;ORIGIN OF TEXT BUFFER.
	TXTEND:	0	;END OF TEXT BUFFER.

SUBR(COMSCAN)	;COMMAND LINE SCAN.
COMMENT .-----------------------------------------------------------.
;RESCAN COMMAND LINE FOR CHARACTERS RIGHT OF SEMI-COLON.
	RESCAN↔INCHSL↔EXIT		;READ CHARACTER LEFT OF SEMICOLON.
	CAIN 15↔EXIT			;EXIT NO SEMICOLON.
	CAIE";"↔GO .-5↔DZM CHRCNT
	CDR JOBFF↔HRLI 440700		;TEXT BUFFER POINTERS.
	DAC TXTPTR↔DAC TXTORG
	INCHSL 1↔EXIT			;READ FIRST CHARACTER.
	DZM BUGFLG#↔CAIN 1,"!"		;"!" FORCES WAIT AFTER RESCAN.
	SETOM BUGFLG↔GO .+3
	INCHSL 1↔GO .+4↔AOS CHRCNT	;READ REMAINING CHARACTERS.
	IDPB 1,0↔GO .-4↔DAC TXTEND
	SKIPN BUGFLG↔POP0J
	OUTSTR[ASCIZ/BEGIN./]		;WAIT FOR DEBUGGER.
	INCHRW↔CRLF↔POP0J
ENDR COMSCAN;3/25/74(BGB)--------------------------------------------
;XGP RASTER SPECIFICATIONS.

;XGP PSEUDO BEAM POSITION.
	ROW:	0
	COL:	0

;XGP RASTER PAGE BUFFER.
	ORGXGP:0	;XGP BUFFER IN CORE.
	ENDXGP:0

;XGP RASTER DIMENSIONS.
	WWIDTH←←=36		;WORD WIDTH OF A ROW.
	NCOLS←←(WWIDTH-1)*=36	;NUMBER OF COLUMNS	IS 1260.
	MROWS←←=1900		;NUMBER OF ROWS		IS 1850.
	BUFSIZ←←WWIDTH*MROWS

;III BUFFER DISPLAY.
	IIIDX: =1024
	IIIDY: =1024
	ROTDEL:0
	SINE:0↔COSINE:1.0	;ORIENTATION.
	SCALEX:1.0↔SCALEY:1.0	;DILATION.

;TEXT JUSTIFICATION PARAMETERS.
	DROW:0		;DELTA PEN POSITION FOR LINE FEED AND SPACE.
	DCOL:0	
	COLMIN:↔LMAR:	0		;OF 1260 COLUMNS.
	COLMAX:↔RMAR:	=1260
	ROWMIN:		=100		;OF 1900 ROWS.
	ROWMAX:		=1800
	TJMODE:	-1			;AUTO CRLF MODE.
	TJFLAG:	 0			;-1 CENTER, +1 RIGHT JUSTIFICATION.

SUBR(MKXBUF)	;MAKE XGP PAGE BUFFER.
COMMENT .-----------------------------------------------------------.
	CDR JOBFF↑↔ADDI 10↔DAC ORGXGP
	ADDI BUFSIZ-1↔DAC ENDXGP↔ADDI =40↔DAP JOBFF
	CORE↔GO[FATAL(CAN'T GET CORE FOR XGP BUFFER.)]
	LAC 1,ORGXGP↔SETZM(1)
	DIP 1,1↔AOS 1↔BLT 1,@JOBREL↑
	POP0J
ENDR MKXBUF;3/24/74(BGB)---------------------------------------------

SUBR(MKFRAM)		;MARKS BORDER OF XGP BUFFER ON PAGE.
COMMENT .-----------------------------------------------------------.
	SETO
	LAC 1,ORGXGP↔MOVEI 2,MROWS
L1:	DPB 0,[POINT 9,1(1),8]
	DPB 0,[POINT 9,=35(1),35]
	ADDI 1,WWIDTH↔SOJG 2,L1
	MOVSI 1,-9*=36
	HRR 1,ORGXGP
L2:	SETOM (1)		; TOP   OF HEADER.
	SETOM =91*=36(1)	; TOP   OF TEXT AREA.
	SETOM =1791*=36(1)	;BOTTOM OF TEXT AREA.
	SETOM =1891*=36(1)	;BOTTOM OF FOOTER.
	AOBJN 1,L2↔POP0J
ENDR MKFRAM;---------------------------------------------------------
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,XGP2D(C)↔ROT 1,6↔HRRI 1,@XGP2D(R)↔DPB 0,1}
COMMENT ⊗

	The DOT macro places a  bit at a given row and  column of the
XGP  buffer. The  2D bit  address byte pointer  is computed  by twice
referencing a 2K table in which the Nth word contains the bytes 0:5(N
div =36) 6:11(N mod =36) 12:17(01) 18:35(orgXGP+N*WWIDTH).

	That is the left halfword of the Nth table entry contains the
base address  of the Nth row; and the right halfword of the Nth table
entry contains a byte pointer to the Nth column.

	In the  DOT macro, the  HLLZ and  ROT instructions setup  the
column  byte pointer  and  the HRRI  instruction (thru  the  magic of
immediate indirect double  indexing) adds the  right halfword of  the
Nth row table entry to the byte pointer. The  use of accumulator 1 is
mandatory   because  of   the  index-byte-size  pun.   The  following
subroutine initializes the table.⊗

SUBR(MKTABL)	;MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
;--------------------------------------------------------------------
	LAC[XWD L,1]↔BLT 11

	LAC ORGXGP↔AOS
	TLO 4301↔GO 3

L:	XWD -100,WWIDTH		;1	INCREMENT.
	XWD -=2048,XGP2D	;2	AOBJN TABLE POINTER TO TABLE.
	DAC 0,(2)		;3
	TLNN 0,7700		;4	TEST FOR =36 OVERFLOW.
	ADD 0,[144B11]		;5	INCREMENT COLUMN WORD COUNT.
	ADD 0,1			;6
	AOBJN 2,3		;7
	POP0J			;8
ENDR MKTABL;BGB 24 MAY 1973._________________________________________

XGP2D:	BLOCK =2048
SUBR(XGPOUT)	OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
COMMENT .-----------------------------------------------------------.
	SKIPE PAGENO↔CALL(EOPAGE)	;PAGE NUMBERING.

;PUT XGP CONTROL WORD IN EACH ROW.
	LAC 0,[1B11+=250B23+WWIDTH-1]		;COLUMN ZERO POSITION.
	LAC 1,ORGXGP↔MOVEI 2,MROWS
	DAC 0,(1)↔ADDI 1,WWIDTH↔SOJG 2,.-2
	MOVSI -BUFSIZ-5				;2+BUFSIZ+3
	HRR ORGXGP↔SUBI 3
	DAC DUMARG				;DUMP ARGUMENT.

;SETUP END CUTS AND SPACES.
	LAC 1,ORGXGP↔SUBI 1,3
	PUSH 1,[1B0]		;CUT AT TOP OF PAGE.
	PUSH 1,[=150B11]	;3/4" MARGIN SPACE AT TOP OF PAGE.
	LAC 1,ENDXGP
	PUSH 1,[=150B11]	;3/4" MARGIN SPACE AT BOTTOM OF PAGE.
	PUSH 1,[1B0]		;CUT AT THE BOTTOM OF PAGE.
	PUSH 1,[0]		;LAST WORD OF XGP BUFFER.

;PRINT A PAGE ON THE XGP.
L1:	LAC PAGENO↔SKIPA↔GO L2		;FOR PATCHING
	INIT 2,17↔SIXBIT/XGP/↔0↔GO[
	  OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔	  POP0J]↔LOCK
	OUTSTR[ASCIZ/PAGE/]
	CALL(TYPEPG)		;TYPE OUT PAGE NUMBER.
	OUTSTR[ASCIZ/ TO XGP.../]
	OUT 2,DUMARG
	UNLOCK↔RELEASE 2,

L2:	CDR ORGXGP
	SETZM@↔DIP↔AOS↔BLT @ENDXGP	;CLEAR XGP PAGE BUFFER.
	OUTSTR[ASCIZ/FINISHED.
/]↔	SKIPE PAGENO↔AOS PAGENO↔POP0J
	DUMARG:	0↔0
ENDR XGPOUT;3/24/74(BGB)------------------------------------------

	PAGENO:	0	;PAGE NUMBER.
SUBR(TYPEPG)
	SKIPN 1,PAGENO↔POP0J↔OUTCHR[" "]
	CAIL 1,=100↔GO[IDIVI 1,=100↔ADDI 1,"0"↔OUTCHR 1↔LAC 1,2↔GO .+2]
	CAIL 1,=10 ↔GO[IDIVI 1,=10 ↔ADDI 1,"0"↔OUTCHR 1↔LAC 1,2↔GO .+1]
				    ADDI 1,"0"↔OUTCHR 1↔POP0J
ENDR TYPEPG;---------------------------------------------------------
SUBR(EOPAGE)
COMMENT .-----------------------------------------------------------.

;SAVE TEXT BUFFER STATUS.
	PUSH P,TXTPTR
	PUSH P,CHRCNT
	PUSH P,EOF

;BOTTOM CENTER OF PAGE.
	MOVEI =1900↔DAC ROW↔SETOM TJFLAG

;CONVERT PAGE NUMBER TO ASCII.
	DZM CHRCNT↔LAC[POINT 7,TXT]↔DAC TXTPTR
	MOVEI "-"↔IDPB TXTPTR↔AOS CHRCNT
	MOVEI " "↔IDPB TXTPTR↔AOS CHRCNT
	LAC PAGENO
	CAIL =100↔GO[IDIVI =100
	ADDI  "0"↔IDPB TXTPTR↔AOS CHRCNT↔LAC 0,1↔GO .+2]
	CAIL =10 ↔GO[IDIVI =10
	ADDI  "0"↔IDPB TXTPTR↔AOS CHRCNT↔LAC 0,1↔GO .+1]
	ADDI  "0"↔IDPB TXTPTR↔AOS CHRCNT
	MOVEI " "↔IDPB TXTPTR↔AOS CHRCNT
	MOVEI "-"↔IDPB TXTPTR↔AOS CHRCNT
	MOVEI 15 ↔IDPB TXTPTR↔AOS CHRCNT
	MOVEI 15 ↔IDPB TXTPTR↔AOS CHRCNT
	LAC[POINT 7,TXT]↔DAC TXTPTR

;COMPUTE CENTER COLUMN AND PRINT.
	CALL(TJLINE)↔SKIPA
L1:	CALL(PRINT)↔CALL(GETCHR)
	CAIE 1,15↔GO L1

;RESTORE TEXT BUFFER STATUS.
	POP P,EOF
	POP P,CHRCNT
	POP P,TXTPTR
	POP0J
TXT:	BLOCK 5
ENDR EOPAGE;---------------------------------------------------------
SUBR(PRINT)	PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
COMMENT .-----------------------------------------------------------.
;Implicit Arguments to PRINT are ROW, COL, CHAR,
;FONT, FONTAB, ORGXGP, ENDXGP, TJMODE.
	ACCUMULATORS{G,B,B2,M,N,I,X16}
	SKIPN CHAR↔POP0J	;IGNORE NULL CHARACTERS.
	LAC 1,FONT		;CURRENT FONT NUMBER.
	SKIPN 2,FONTAB(1)↔POP0J	;FONT BASE ADDRESS.
	LAC I,203(2)		;ROWS BETWEEN TOP AND BASE LINE.
	ADD 2,CHAR		;POINTER INTO FONT'S CHARACTER TABLE.
	CAR N,(2)		;COLS WIDE OF THE GLYPH.
	CDR G,(2)↔SKIPN G↔POP0J ;EXIT WHEN NO CHARACTER.
	ADD G,FONTAB(1)↔AOS G	;CHARACTER'S GLYPH POINTER.
	CDR M,(G)		;ROWS HIGH OF THE GLYPH.
	CAR 0,(G)		;ROWS FROM TOP TO FIRST ROW OF GLYPH.
	SUB 0,I			;ROWS ABOVE CURRENT XGP PEN POSITION.
	ADD 0,ROW
	IMULI WWIDTH
	ADD ORGXGP↔HRRZM B	;WORD POINTER INTO XGP BUFFER.
	LAC 0,COL
	SKIPE TJMODE↔GO .+3	;CLIP LINE OVERFLOW IF TJMODE=0
	CAML 0,RMAR↔POP0J
	IDIVI 0,=36		;REMAINDER IN AC-1 !
	AOS↔ADD B,0↔DAC B,B2	;WORD POINTER INTO XGP BUFFER.
 	ADDM N,COL		;UPDATE XGP PEN COLUMN POSITION.
	TLO G,444400↔AOS G	;SETUP GLYPH BYTE POINTER.
	CAILE N,=36↔GO[
	IDIVI N,=36↔AOJA N,L0]	;WHEN CHARACTER WIDTH ≥ =36.
	DPB N,[POINT 6,G,11]	;SIZE OF BYTE.
	ADD 1,N↔SUBI 1,=36	; =36 - CHRWID - REMAINDER
	MOVEI N,1
L0:	MOVNS 1↔DAP 1,L3	;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.

;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.

L1:	LAC I,N
L2:	ILDB 0,G↔SETZ 1,
L3:	LSHC 0,0
	CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
	AOS B↔JUMPE 1,L4
	CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4:	SOJG I,L2↔LAC B,B2
	ADDI B,WWIDTH↔DAC B,B2
	SOJG M,L1
	POP0J
ENDR PRINT;5/23/73(BGB)----------------------------------------------
SUBR(GETCHR)	GET A NON-NULL CHARACTER FROM THE TEXT BUFFER.
COMMENT .-----------------------------------------------------------.
	SOSL CHRCNT↔GO[
	ILDB 1,TXTPTR↔JUMPE 1,.-1
	DAC 1,CHAR↔POP0J]
	SETOM EOF↔SETZ 1,
	POP0J
ENDR GETCHR;5/30/73(BGB)---------------------------------------------

	EOF:	0	;END OF FILE.
	CHAR:	0	;CURRENT CHARACTER.

SUBR(GETNUM)	GET AN INTEGER.
COMMENT .-----------------------------------------------------------.
	SETZM↔CALL(GETCHR)
	CAIL 1,"0"↔CAILE 1,"9"↔GO[
	EXCH 1,0↔POP0J]↔ANDI 1,17
	IMULI 0,=10↔ADD 0,1
	GO GETNUM+1
ENDR GETNUM;---------------------------------------------------------

SUBR(GETFIL)	;GET FILE SPECIFICATION - SKIP OK.
COMMENT .-----------------------------------------------------------.

;CLEAR FILENAME SPECIFICATION.
	DZM FILNAM
	DZM EXTION
	DZM EXTION+1
	DZM PPPN

;ACCUMULATORS.
	C ←← 1	;CHARACTER.
	N ←← 2	;COUNT.
	Q ←← 4	;BYTE POINTER.
	
	LAC Q,[POINT 6,FILNAM,-1]↔MOVEI N,6
L:	CALL(GETCHR)
	CAIN  C,15↔GO[CALL(GETCHR)↔GO EOL]
	CAILE C,"z"↔POP0J
	CAIL C,"a"↔SUBI C,40		;CONVERT LOWER CASE
	CAIN C,"."↔GO[LAC Q,[POINT 6,EXTION,-1]↔MOVEI N,3↔GO L]
	CAIN C,"["↔GO[LAC Q,[POINT 6,PPPN,-1]  ↔MOVEI N,3↔GO L]
	CAIN C,","↔GO[LAC Q,[POINT 6,PPPN,17]  ↔MOVEI N,3↔GO L]
	CAIN C,"]"↔CALL(GETCHR)
	CAIN C,";"↔GO EOL	;XAP COMMAND POSTFIX.
	CAIG C," "↔GO EOL
	SOJL N,L↔SUBI C,40	;COUNT'EM AND CONVERT TO SIXBIT.
	IDPB C,Q↔GO L		;PACK CHARACTER INTO SPECIFICATIONS.
EOL:	
	CAR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DIP PPPN
	CDR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DAP PPPN
	AOS(P)↔POP0J

ENDR GETFIL;5/30/73(BGB)---------------------------------------------

;DISK FILE SPECIFICATION.
	FILNAM:	0	;FILE NAME.
	EXTION:	0↔0	;EXTENSION.
	PPPN:	0↔0	;PROJECT-PROGRAMMER.
;FONT SPECIFICATION.
	FONT: 1
	FONTAB: BLOCK =45
	FNTPPN:	SIXBIT/XGPSYS/		;DEFAULT FONT PPN

;DEFAULT FONT NUMERAL NAMES.

FNTNAM: 0		;0	"RON ZIEGLER" FONT.
	SIXBIT/LPT/	;1	LINE PRINTER.
	SIXBIT/FIX13X/	;2	FIXED WIDTH FONTS.
	SIXBIT/FIX20/	;3
	SIXBIT/FIX25/	;4
	SIXBIT/FIX30/	;5
	SIXBIT/FIX40/	;6

	SIXBIT/NGR13/	;7	NEW GOTHIC ROMAN.
	SIXBIT/NGR20/	;8
	SIXBIT/NGR25/	;9
	SIXBIT/NGB25/	;A
	SIXBIT/NGR40/	;B

	SIXBIT/BDR25/	;C	BODONI ROMAN
	SIXBIT/BDI25/	;D	BODONI ITALIC

	SIXBIT/XMAS25/	;E	PSEUDO OLDE ENGLISH.
	SIXBIT/SIGN57/	;F
	SIXBIT/GRK25/	;G	GREEK.
	SIXBIT/SET1/	;H	TOVAR'S CREATION.
	SIXBIT/SUB/	;I
	SIXBIT/SUP/	;J
	BLOCK ("Z"-"H")	;TO Z -	EMPTY SPACE.

COMMENT ⊗ STANFORD FONT FILE FORMAT.---------------------------------

WORDS 0-177:
	XWD CHARACTER_WIDTH,CHARACTER_ADDRESS
WORDS 200-237:
	CHARACTER_SET_NUMBER
	HEIGHT
	MAX_WIDTH (IN BITS)
	BASE LINE (BITS FROM TOP OF CHARACTER)
WORDS 240-377:
	ASCIZ/FONT DESCRIPTION/
REMAINDER OF FILE:
	    EACH CHARACTER:
		CHARACTER_CODE,,WORD_COUNT+2
		ROWS_FROM_TOP,,DATA_ROW_COUNT
		BLOCK WORD_COUNT
--------------------------------------------------------------------⊗

SUBR(DEFONT)	DEFINE FONT NUMERAL N; TAKES N FROM AC-1.
COMMENT .-----------------------------------------------------------.
	DZM FILNAM		      ;ENTRY   - SCAN FOR FILENAME.
	INIT 1,17↔SIXBIT/DSK/↔0	      ;ENTRY+1 - DON'T SCAN FILENAME.
	GO[FATAL(CAN'T INIT DSK)]
	DAC 1,FONTCH
	SKIPE FILNAM↔GO L1
	CALL(GETCHR)↔ANDI 1,17↔DAC 1,FONT	;FONT NUMERAL.
	CALL(GETFIL)↔GO L3			;FONT FILE NAME.

;FIND FONT FILE.
L1:	LOOKUP 1,FILNAM↔GO[
	  MOVEI 'FNT'↔SKIPN EXTION↔HRLZM EXTION
	  LOOKUP 1,FILNAM↔GO[
	    LAC FNTPPN↔SKIPN PPPN↔DAC PPPN
	    LOOKUP 1,FILNAM↔GO[
	      OUTSTR[ASCIZ/ FONT NOT FOUND.
		/]↔GO L3]↔GO L2]↔GO L2]

;DUMP INPUT FONT FILE TO TOP OF CORE.
L2:	LAC 1,FONT↔CDR 2,JOBFF		;FONT NUMBER.
	LAC 0,2↔DAC FONTAB(1)		;FONT BASE ADDRESS.
	HLL PPPN↔SOS↔DAC INARG		;IOWD DUMP ARGUMENT.
	MOVS PPPN↔MOVMS↔ADDI 1(2)	;TOP OF THE FONT.
	DAP JOBFF↔CORE↔HALT		;EXPAND CORE.
	IN 1,INARG↔SKIPA↔HALT
	CALL(SETFNT)
L3:	RELEASE 1,
	POP0J
↑FONTCH: 0
INARG:0↔0
ENDR DEFONT;2/7/73(TVR)2/25/73(BGB)----------------------------------

SUBR(SETFNT)	SETUP A FONT, IMPLICIT ARGUMENT FONT.
COMMENT .-----------------------------------------------------------.
	LAC 1,FONT↔CDR 2,FONTAB(1)	;GET FONT BASE ADDRESS.
	SKIPN 2↔POP0J			;EXIT WHEN FONT MISSING.
	MOVEI =40↔DAC DROW		;LINE FEED DEFAULT.
	SKIPE 1,201(2)↔DAC 1,DROW	;LINE FEED SPECIFIED.
	LAC XLINE↔ADDM DROW		;INTER LINE SPACING.
	MOVEI =25↔DAC DCOL		;SPACE DEFAULT.
	SKIPE 1,202(2)↔DAC 1,DCOL	;SPACE SPECIFIED.
	POP0J
ENDR SETFNT;2/7/72(TVR)----------------------------------------------

SUBR(XFONT)	;"F<N>" FONT SELECT AND ENTER TEXT MODE.
COMMENT .-----------------------------------------------------------.
	CALL(GETCHR)↔DZM CMODE
	CAIN  1,"."↔GO L1		;NO CHANGE.
	CAIGE 1,"0"↔GO L1
	CAIG  1,"9"↔ANDI 1,17
	CAIL  1,"A"↔GO[ANDI 1,37
	  ADDI 1,=9↔GO .+1]
	DAC 1,FONT
	SKIPE FONTAB(1)↔GO L1		;IS FONT IN CORE YET.
	LAC FNTNAM(1)↔DAC FILNAM	;FONT NAME
	LAC[SIXBIT/FNT/]↔DAC EXTION	;FONT EXTENSION.
	LAC FNTPPN↔DAC PPPN		;DEFAULT FONT PPPN.
	CALL(<DEFONT+1>)
L1:	SKIPE TJFLAG↔CALL(TJLINE)	;CENTER OR RIGHT JUSTIFY.
	POP0J
ENDR XFONT;3/26/74(BGB)----------------------------------------------

;ASCII JUMP TABLE.
;XWD TEXT_MODE,,COMMAND_MODE
A00:	0	;null.					;00-07.
	0	;"↓"
	0	;"α"
	0	;"β"
	0	;"∧"
	0	;"¬"
	0	;"ε"
	0	;"π"
	XXLINE	;"λ"					;10↔17.
XWD %+HTAB,0	;tab.
XWD %+LFEED,0	;LF
	0	;VT.
XWD FFEED,FFEED	;FF.
XWD %+CRETURN,0	;CR.
	0	;"∞"
	0	;"∂"
XWD LFS+4,DFS+4	;"⊂"	LEFT FONT SELECT DELIMITER	;20-27.
XWD RFS+4,0	;"⊃"	RIGHT FONT SELECT DELIMITER
	0	;"∩"
	0	;"∪"
	0	;"∀"
	MKFRAM	;"∃"
	IIISIM	;"⊗"	III DISPLAY BUFFER - CORNER ORIGIN.
	0	;"↔"
	0	;"_"					;30-37.
	0	;"→"
XWD ESCTXT,ESCCOM ;"~" TILDE.
	0	;"≠"
XWD LFS+5,DFS+5	;"≤"	LEFT FONT SELECT DELIMITER
XWD RFS+5,0	;"≥"	RIGHT FONT SELECT DELIMITER
	0	;"≡"
	0	;"∨"
XWD %+SPACE,0	;SPACE.					;40-47.
	0	;"!"
	0	;"""
	0	;"#"
	0	;"$"
	0	;"%"
	0	;"&"
	0	;"'"
XWD LFS+2,DFS+2	;"("	LEFT FONT SELECT DELIMITER	;50-57.
XWD RFS+2,0	;")"	RIGHT FONT SELECT DELIMITER
	IIISIM	;"*"	III DISPLAY BUFFER - CENTER ORIGIN.
	0	;"+"
	0	;","
	0	;"-"
	0	;"."
	0	;"/"
	0	;"0"					;60-67.
	0	;"1"
	0	;"2"
	0	;"3"
	0	;"4"
	0	;"5"
	0	;"6"
	0	;"7"
	0	;"8"					;70-77.
	0	;"9"
	0	;":"
	0	;";"
	0	;"<"
	0	;"="
	0	;">"
	0	;"?"
	INFILE		;"@" 	INDIRECT FILE COMMAND		;100-107.
	0		;"A"
	XBOX		;"B"
	0		;"C"
	0		;"D"
	0		;"E"
	XFONT		;"F"	SELECT FONT AND ENTER TEXT MODE.
	0		;"G"
	XHEAVY		;"H"	HEAVY LINES.			;110-117.
	AI		;"I"	ABSOLUTE INVISIBLE VECTOR.
	XJUSTM		;"J"
	0		;"K"
	XLOCUS		;"L"
	DEFONT		;"M"	MAKE A FONT NUMBER.
	0		;"N"
	XROTAT		;"O"	SET ORIENTATION.
	XSETPAGE	;"P"	SET PAGE NUMBER.		;120-127.
	0		;"Q"
	XRADIAL		;"R"
	0		;"S"
	0		;"T"
	0		;"U"
	AV		;"V"	ABSOLUTE VISIBLE VECTOR.
	XWINDO		;"W"
	XXSCAL		;"X"	SET X SCALE.			;130-137.
	0		;"Y"
	0		;"Z"
XWD LFS+3,DFS+3		;"["	LEFT FONT SELECT DELIMITER
	0		;"\"
XWD RFS+3,0		;"]"	RIGHT FONT SELECT DELIMITER
	0		;"↑"
	0		;"←"
;TEXT JUSTFICATION MODES.
;TJMODES:	;-1	JA	AUTO CRLF DEFAULT.
		; 0	JV	VIDEO CLIPPED MODE.
		;+1	JU	JUSTIFY MODE.
;TJFLAG:	;-1	JC	CENTER JUSTIFY A LINE.
		;+1	JR	RIGHT JUSTIFY A LINE.
;EXECUTE "J" COMMAND.------------------------------------------------
XJUSTM:	CALL(GETCHR)↔MOVEI 1
	CAIN 1,"A"↔SETOM TJMODE		;JUSTIFY AUTOMATIC CRLF.
	CAIN 1,"V"↔DZM TJMODE		;JUSTIFY VIDEO.
	CAIN 1,"U"↔DAC TJMODE		;JUSTIFY.
	CAIN 1,"C"↔SETOM TJFLAG		;JUSTIFY CENTER.
	CAIN 1,"R"↔DAC TJFLAG		;JUSTIFY RIGHT.
	POP0J
;--------------------------------------------------------------------
SPACE:
	LAC 1,FONT		;THE FONT.
	SKIPN 1,FONTAB(1)↔HALT
	CAR 0," "(1)		;THE WIDTH OF A SPACE.
	ADDM 0,COL		;NEW CARRIAGE POSITION.
	POP0J
CRETURN:
	LAC 1,COLMIN
	DAC 1,COL
	POP0J
LFEED:
	LAC 1,FONT
	SKIPN 1,FONTAB(1)↔HALT
	LAC 1,201(1)	;MAXIMUM HEIGHT.
	ADD 1,XLINE
	ADDM 1,ROW
	POP0J
HTAB:
	LAC 1,FONT		;THE FONT.
	SKIPN 1,FONTAB(1)↔HALT
	CAR 0," "(1)		;THE WIDTH OF A SPACE.
	LAC 1,COL↔SUB 1,COLMIN	;CARRIAGE POSITION.
	IDIV 1,0↔ANDCMI 1,7	;THE OCTADE OF THE NUMBER OF SPACES.
	ADDI 1,8		;NEXT OCTADE.
	IMUL 1,0		;NEW CARRIAGE POSITION.
	ADD  1,COLMIN↔DAC 1,COL
	SKIPLE TJMODE		;SKIP WHEN MODE IS -1 OR 0.
	GO JUSTIFY
	POP0J
ESCTXT:	SETOM CMODE↔POP0J		;ESCAPE TEXT - ENTER COMMAND MODE.
ESCCOM: DZM CMODE
	POP0J			;ESCAPE COMMAND  - ENTER TEXT MODE.
FFEED:	SETOM EOP↔POP0J
XXLINE:	CALL(REALIN)↔FIXX↔MOVMM XLINE↔POP0J

XWINDO:	CALL(REALIN)↔FIXX↔MOVMM COLMIN↔CAIE 1,","↔POP0J
	CALL(REALIN)↔FIXX↔MOVMM COLMAX↔CAIE 1,","↔POP0J
	CALL(REALIN)↔FIXX↔MOVMM ROWMIN↔CAIE 1,","↔POP0J
	CALL(REALIN)↔FIXX↔MOVMM ROWMAX↔           POP0J
SUBR(JUSTIFY)	;PRINT A JUSTIFIED PARAGRAPH OF TEXT.
COMMENT ⊗------------------------------------------------------------
	A justified paragraph begins with a TAB and ends with one of
five possible terminations: 1. end of file; 2. escape character;
3. form feed; 4. CRLF-TAB; 5. CRLF-CRLF. The main role of this routine
is to find the end of the paragraph; then it calls LNSCAN and LNJUST
until all the full lines are printed. 
;-------------------------------------------------------------------⊗
	PUSH P,TXTPTR		;SAVE INITIAL STATE OF THE SCANNER.
	PUSH P,CHRCNT
L1:	LAC TXTPTR↔DAC ENDPTR	;SAVE PTR TO POTENTIAL END CHARACTER.
	CALL(GETCHR)
	SKIPE  EOF↔GO L2	;1. END OF FILE EXCLUSIVE.
	CAMN 1,ESC↔GO L2	;2. ESCAPE CHARACTER EXCLUSIVE.
	CAIN 1,14 ↔GO L2	;3. FORM FEED EXCLUSIVE.
	CAIE 1,15 ↔GO L1	;SKIP ON 1ST CARRIAGE RETURN.

;CARRIAGE RETURN LOOK AHEAD.
	LAC  0,TXTPTR
	ILDB 1,0↔CAIE 1,12↔GO L1	;LINE FEED INCLUSIVE.
	DAC  0,ENDPTR
	ILDB 1,0↔CAIN 1,11↔GO L2	;4. CRLF TAB.
 	         CAIE 1,15↔GO L1	;2ND CARRIAGE RETURN.
	ILDB 1,0↔CAIE 1,12↔GO L1	;5. CRLF CRLF.

;FOUND END OF PARAGRAPH (INCLUSIVE AND EXCLUSIVE).
L2:	POP P,CHRCNT		;RESTORE SCANNER TO INITIAL POSITION.
	POP P,TXTPTR

;PRINT ALL THE FULL LINES OF THE PARAGRAPH.
L3:	CALL(LNSCAN)			;LINE SCAN FOR SPACES.
	CALL(LNJUST)			;LINE JUSTIFY AND PRINT.
	LAC TXTPTR↔CAME ENDPTR↔GO L3	;TEST FOR END OF PARAGRAPH.
	POP0J

;BYTE POINTER TO LAST CHARACTER OF THE PARAGRAPH INCLUSIVE.
	↑ENDPTR: 0	;IMPLICIT ARGUMENT FOR LNSCAN.
ENDR JUSTIFY;9/20/73(BGB)--------------------------------------------
SUBR(LNSCAN)	;LINE SCAN FOR SPACES COUNT.
COMMENT ⊗------------------------------------------------------------
	Scan for left margin overflow, while keeping track of the
number of spaces seen and the position of the last space seen.
--------------------------------------------------------------------⊗
	ACCUMULATORS{CHR}
;INITIALIZATION.
	LAC COL↔DAC COLUMN		;TJ LEFT MARGIN.
	DZM SPACNT↔DZM SPAPTR↔DZM SPACOL
	LAC TXTPTR↔DAC LNPTR
	DZM SPAFLG			;IGNORE LEADING SPACES.
;TEST FOR END OF LINE SCAN.
L1:	LAC LNPTR↔CAMN ENDPTR↔GO[	;EXIT END OF PARAGRAPH.
	DZM SPAPTR↔DZM SPACNT↔POP0J]
	LAC COLUMN↔CAML COLMAX↔POP0J	;EXIT LINE FULL.

;FETCH A CHARACTER.
	ILDB CHR,LNPTR
	CAIN CHR,12↔GO L1	;IGNORE LINEFEEDS.
	CAIN CHR,00↔GO L1	;IGNORE NULLS.
	CAIN CHR,11↔MOVEI CHR,40	;CONVERT TAB INTO A SPACE.
	CAIN CHR,15↔MOVEI CHR,40	;CONVERT CR  INTO A SPACE.
;SAVE THE STATUS OF THE LATEST SPACE.
	CAIE CHR,40↔GO L2
	AOSE SPAFLG↔GO L1	;IGNORE MULTIPLE SPACES.
	AOS SPACNT		;INCREMENT SPACE COUNT.
	LAC COLUMN↔DAC SPACOL	;SAVE SPACE POSITION.
	LAC LNPTR↔DAC SPAPTR	;SAVE SPACE BYTE POINTER.
	LAC 1,FONT↔LAC 1,FONTAB(1)	;FONT BASE ADDRESS.
	ADD 1,CHR↔CAR 0,(1)		;WIDTH OF SPACE.
	SKIPE DOUBLE↔ASH 0,1		;DOUBLE WIDTH SPACE.
	ADDB 0,COLUMN↔GO L1

;ACCUMULATE CHARACTER WIDTHS - NOT SPACE.
L2:	SETOM SPAFLG#↔DZM DOUBLE#
	CAIN CHR,"."↔SETOM DOUBLE
	CAIN CHR,"?"↔SETOM DOUBLE
	LAC 1,FONT↔LAC 1,FONTAB(1)	;FONT BASE ADDRESS.
	ADD 1,CHR↔CAR 0,(1)		;WIDTH OF CHARACTER.
	ADDB 0,COLUMN↔GO L1

;GLOBAL VARIABLES FOR COMMUNICATION TO LNJUST.
	↑LNPTR:	0	;END OF LINE POINTER.
	↑SPACNT:0	;SPACE COUNT.
	↑SPAPTR:0	;BYTE POINTER TO LATEST SPACE.
	↑SPACOL:0	;COLUMN POSITION OF LATEST SPACE.
	COLUMN:	0	;LOOK AHEAD COLUMN POSITION.
ENDR LNSCAN;9/20/73(BGB)---------------------------------------------
SUBR(LNJUST)	;LINE JUSTIFY AND PRINT.
;IMPLICIT ARGUMENTS:

	PTR←←14
	LAC COLMAX↔SUB SPACOL↔DAC EXTRA		;EXTRA SPACE.
	SKIPLE SPACNT↔SOS SPACNT↔DZM SPAFLG	;IGNORE LEADING SPACES.

;PRINT CHARACTERS  -  ADJUST SPACE SIZES.
L1:	LAC TXTPTR
	CAMN ENDPTR↔GO EOL	;TEST FOR END OF PARAGRAPH.
	CAMN  LNPTR↔GO EOL	;TEST FOR ABNORMAL END OF LINE.
	CALL(GETCHR)↔LAC TXTPTR	
	CAMN SPAPTR↔GO EOL	;TEST FOR NORMAL END OF LINE.
	CAIN 1,12↔GO L1		;IGNORE LINEFEEDS.
	CAIN 1,00↔GO L1		;IGNORE NULLS.
	CAIN 1,11↔MOVEI 1,40	;CONVERT TAB INTO A SPACE.
	CAIN 1,15↔MOVEI 1,40	;CONVERT CR  INTO A SPACE.
	CAIE 1,40↔SETOM SPAFLG#
	CAIE 1,40↔DZM DOUBLE#			;NOT SPACE - RESET.
	CAIE 1,"."↔CAIN 1,"?"↔SETOM DOUBLE#	;PERIOD OR QUESTION MARK.
	DAC  1,CHAR

;EXECUTE A FONT CHANGE.

;PRINT THE CHARACTER.
	CAIN 1,40↔GO L2
	CALL(PRINT)↔GO L1

;COMPUTE A VARIABLE SPACE SIZE.
L2:	AOSE SPAFLG↔GO L1		;IGNORE MULTIPLE SPACES.
	SETZ↔SKIPN SPACNT↔GO L3		;TEST FOR NO VARIABLE SPACES.
	LAC 0,EXTRA↔IDIV 0,SPACNT
	SOS SPACNT
	LAC 1,EXTRA↔SUB 1,0↔DAC 1,EXTRA

;PRINT A VARIABLE SPACE.
L3:	LAC 1,FONT
	SKIPN 1,FONTAB(1)↔HALT
	CAR 1,40(1)			;WIDTH OF NORMAL SPACE.
	SKIPE DOUBLE↔ASH 1,1		;DOUBLE WIDTH SPACE.
	ADD 1,0↔ADDM 1,COL		;ADVANCE COL VARIABLE SPACE.
	GO L1

;EXECUTE A CARRIAGE RETURN LINE FEED.
EOL:	LAC COLMIN↔DAC COL	;CARRIAGE RETURN.
	GO LFEED
DECLARE{EXTRA}
ENDR LNJUST;9/20/73(BGB)---------------------------------------------
SUBR(TJLINE)	;CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
COMMENT .-----------------------------------------------------------.

;SKIP OVER LEADING BLANKS.
	DZM TOTAL
	PUSH P,TXTPTR↔PUSH P,CHRCNT	;SAVE SCANNER POSITION.
	CALL(GETCHR)↔CAIE 1,40↔GO L1+1
	POP P,0↔POP P,0↔GO TJLINE	;FLUSH THE STACK.
;FETCH A CHARACTER AND DO CONVERSIONS.
L1:	CALL(GETCHR)
	CAIN 1,00↔GO L1			;IGNORE NULLS.
	CAIN 1,11↔MOVEI 1,40		;CONVERT TABS TO BLANKS.
;LINE TERMINATION ON CR OR ESCAPE
	CAIN 1,15↔GO L2
	CAMN 1,ESC↔GO L2
;ACCUMULATE CHARACTER WIDTH INTO TOTAL.
	LAC 2,FONT↔LAC 2,FONTAB(2)	;FONT BASE ADDRESS.
	ADD 2,1↔CAR 0,(2)		;WIDTH OF CHARACTER.
	ADDM 0,TOTAL↔GO L1
;SET COLUMN FOR CENTER OR RIGHT JUSTIFICATION.
L2:	LAC COLMAX↔SUB COLMIN↔SUB TOTAL	;EXTRA SPACE IN XGP UNITS.
	MOVM↔SKIPGE TJFLAG↔ASH -1	;HALVE WHEN CENTERING.
	ADD COLMIN↔DAC COL
	DZM TJFLAG
;RESTORE THE SCANNER AND EXIT.
	POP P,CHRCNT↔POP P,TXTPTR
	POP0J
DECLARE{TOTAL}
ENDR TJLINE;9/23/73(BGB)---------------------------------------------
;FONT SELECT DELIMITERS.
	FSD:BLOCK 7
;FIVE PAIRS: {} () [] ⊂⊃ ≤≥

;DECLARE FONT SELECT DELIMITER  -  COMMANDS  {N; (N; [N; ⊂N; ≤N;
DFS:	GO .+6↔GO .+5↔GO .+4
	GO .+3↔GO .+2↔GO .+1
	SUBI DFS↔ADDI FSD
	CALL(GETCHR)
	CAIGE 1,"0"↔POP0J
	CAIG  1,"9"↔ANDI 1,17
	CAIL  1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
	DIP 1,@↔SKIPE FONTAB(1)↔POP0J	;IS IT LOADED YET.
	PUSH P,FONT↔DAC 1,FONT
	LAC FNTNAM(1)↔DAC FILNAM
	LAC[SIXBIT/FNT/]↔DAC EXTION
	LAC FNTPPN↔DAC PPPN
	CALL(<DEFONT+1>)↔POP P,FONT
	POP0J

;LEFT FONT SELECT DELIMITER - TEXT MODE SELECT FONT.
LFS:	GO .+6↔GO .+5↔GO .+4
	GO .+3↔GO .+2↔GO .+1
	SUBI LFS↔ADDI FSD
	CAR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
	EXCH 1,FONT↔DAP 1,@	;SAVE RETURN FONT NUMBER.
	CALL(SETFNT)
	POP0J

;RIGHT FONT SELECT DELIMITER - TEXT MODE  RESTORE FONT.
RFS:	GO .+6↔GO .+5↔GO .+4
	GO .+3↔GO .+2↔GO .+1
	SUBI RFS↔ADDI FSD
	CDR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
	DAC 1,FONT
	CALL(SETFNT)
	POP0J
SUBR(MKSEG0)	MAKE LINE SEGMENT.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{R1,C1,R2,C2,Q,N} ↔  DR←←R2 ↔ DC←←C2
	SKIPE HEAVY↔CALL(MKSEG1)
;CLIPPING - EASY INSIDER.
	SETO
	SKIPL R1↔CAIL R1,MROWS↔SETZ
	SKIPL C1↔CAIL C1,NCOLS↔SETZ
	SKIPL R2↔CAIL R2,MROWS↔SETZ
	SKIPL C2↔CAIL C2,NCOLS↔SETZ
	DAC FLAG#

;CLIPPING - EASY OUTSIDER.
L0:	CAML R2,R1↔GO .+3		;FORCE DOWN VECTOR.
	EXCH R1,R2↔EXCH C1,C2
	SKIPL R2↔CAIL R1,MROWS↔POP0J	;ROWS OUT OF BOUNDS.
	LAC 0,C1↔LAC 1,C2
	CAML 0,1↔EXCH 0,1
	SKIPL 1↔CAIL 0,NCOLS↔POP0J	;COLUMNS OUT OF BOUNDS.

;INITIALIZE BIT PACK LOOP.
	SUB R2,R1↔SUB C2,C1		;DELTA ROWS & COLUMNS.
	MOVEI (<AOS>)			;LEFT TO RIGHT VECTOR.
	SKIPGE DC↔MOVEI (<SOS>)		;RIGHT TO LEFT VECTOR.
	DIP L2+1↔DIP L5+1↔MOVMS DC	;OLDE FASHION PDP-1 DIP.
	LAC N,DC↔CAMGE N,DR↔LAC  N,DR	;NUMBER OF DOTS.
	ASH DC,=17↔IDIV DC,N↔LAC DC	;DELTA COL PER DOT.
	ASH DR,=17↔IDIV DR,N↔DAC DC	;DELTA ROW PER DOT.
	DIP DR,DC↔SETZ Q↔SETO		;REMAINDER & BIT.
	SKIPN FLAG↔GO L3

;LINE SEGMENT FULLY WITHIN WINDOW.
L1:	DOT(R1,C1)↔ADD  Q,DC		;PLOT THE DOT & ADVANCE.
	TLZE Q,%↔AOS R1			;ROW OVERFLOW.
L2:	TRZE Q,%↔AOS C1			;COL OVERFLOW.
	SOJGE N,L1↔POP0J

;LINE SEGMENT PARTIALLY WITHIN WINDOW.
L3:	JUMPL R1,L4↔CAIL R1,MROWS↔POP0J
	JUMPL C1,L4↔CAIL C1,NCOLS↔GO L4
	DOT(R1,C1)
L4:	ADD  Q,DC
	TLZE Q,%↔AOS R1			;ROW OVERFLOW.
L5:	TRZE Q,%↔AOS C1			;COL OVERFLOW.
	SOJGE N,L3↔POP0J

ENDR MKSEG0;28 MARCH 1974 BGB;---------------------------------------
SUBR(MKSEG1)		;MAKE HEAVY LINES.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{R1,C1,R2,C2,DR,DC,N}
	LAC N,HEAVY↔PUSH P,HEAVY↔SETZM HEAVY
	LAC DR,R1↔SUB DR,R2↔MOVMS DR
	LAC DC,C1↔SUB DC,C2↔MOVMS DC
L1:	SAVAC(8)↔CALL(MKSEG0)↔GETAC(8)
	SOJLE N,[POP P,HEAVY↔POP0J]
	CAMGE DR,DC↔GO[
	AOS R1↔AOS R2↔GO L1]
	AOS C1↔AOS C2↔GO L1]
ENDR MKSEG1;28 MARCH 1974 BGB ---------------------------------------
SUBR(IIISIM)	OUTPUT III BUFFER ONTO XGP.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{X,Y,R,C,IIIWRD}

;DELTA ORIGIN DISPLACEMENT.
	MOVSI 1,(2B2)↔LAC CHAR
	CAIN"*"↔SETZ 1,↔DAC 1,DELTA

;III FILE NAME.
	CALL(GETFIL)↔POP0J
	INIT 17,17↔SIXBIT/DSK/↔0
	GO[FATAL(CAN'T INIT DSK)]
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/PLT/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/III/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/DAT/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/TMP/]↔DAC EXTION
	LOOKUP 17,FILNAM↔GO[FATAL<III OR VIDEO FILE NOT FOUND.>]
	GO L0]↔GO L0]↔GO L0]↔GO L0]

;EXPAND CORE FOR DUMP INPUT.
L0:	LAC JOBREL↔DAC OLD44#
	HLRE 1,PPPN↔MOVN 1,1
	ADD 1,JOBREL↔DAC 1,BUFEND#
	CORE 1,↔GO[FATAL(CAN'T EXPAND CORE)]

;SAVE CURRENT XGP BEAM POSITION.
	LAC FONT↔DAC BEGFNT#
	LAC COL↔DAC BEGCOL#
	LAC ROW↔DAC BEGROW#
	MOVEI 2↔DAC IIISIZ	;INITIAL III CHARACTER SIZE.
;DUMP III FILE IN.
	LAC OLD44↔ADDM PPPN↔IN 17,PPPN
	LAC 1,OLD44↔LAC(1)↔CAMN[-1]↔GO VIDEO	;TEST 1ST WORD = -1.
	LAC 1,OLD44↔ADDI 1,2↔DAC 1,PC#		;III PC.
	SKIPN 1(1)↔AOS PC			;STEP OVER QUAM'S DEAD WORD.
L1:	CDR 1,BUFEND↔DZM -1(1)↔DZM(1)
        CAML 1,JOBREL↔GO .+3
	HRLI 1,-1(1)↔BLT 1,JOBREL		;CLEAR TOP.
	CDR JOBREL↔DAP JOBFF
	;FETCH AND DECODE III COMMAND WORD.
ILOOP:	AOSA 1,PC
LOOP:	LAC 1,PC↔CAMLE 1,OLD44
	CAML 1,BUFEND↔GO RET
	LAC IIIWRD,(1)
	TRNE IIIWRD,01↔GO XTEXT		;TEXT COMMAND WORD.
	TRNE IIIWRD,02↔GO XVECTR	;VECTOR COMMAND WORD.
	TRNE IIIWRD,20↔GO XCTRL		;III CONTROL WORD.
	TRNE IIIWRD,37↔GO ILOOP		;NOP & HALT COMMANDS.
RET:	LAC OLD44↔CORE↔GO[FATAL(CAN'T SHRINK CORE!)]
FRET:	RELEASE 17,
	LAC BEGFNT↔DAC FONT
	LAC BEGCOL↔DAC COL
	LAC BEGROW↔DAC ROW
	POP0J

	;EXECUTE III TEXT.
XTEXT:	PUSH P,IIIWRD			;-2(P)
	PUSH P,[5]			;-1(P)
	PUSH P,[POINT 7,-2(P)]		; 0(P)
CLOOP:	ILDB 1,0(P)↔JUMPE 1,CCONT↔DAC 1,CHAR
	CAIN 1,15↔GO[
		LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-12
		MOVNS 1↔ADDM 1,YBEAM
		LAC 1,[-511]↔DAC 1,XBEAM↔GO CCONT]
	PUSH P,ROW↔PUSH P,COL	;SAVE XGP-BEAM POSITION.

;COMPUTE XGP ROW AND COLUMN.
	MOVN R,YBEAM↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW↔DAC R,ROW
	LAC  C,XBEAM↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL↔DAC C,COL
	LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-13↔ADDM 1,XBEAM

;COMPUTE FONT SIZE.
	LAC 1,IIISIZ↔LAC CHRWID(1)↔FLOAT↔FMP SCALEX↔FIXX↔MOVEI 1,1
	CAIL 0,=7↔AOS 1
	CAIL 0,=20↔AOS 1↔CAIL 0,=25↔AOS 1
	CAIL 0,=30↔AOS 1↔CAIL 0,=40↔AOS 1
	CAIN 1,1↔GO[LAC 1,CHAR↔SETO↔CAIN 1,40↔GO CCONT2
		LAC R,ROW↔LAC C,COL
		CAMG R,ROWMAX↔CAMGE R,ROWMIN↔GO CCONT2
		DOT(R,C)↔GO CCONT2]
	CAMN 1,FONT↔GO CCONT3↔DAC 1,FONT
	SKIPE FONTAB(1)↔GO CCONT4
	DAC 1,FONT↔LAC FNTNAM(1)↔DAC FILNAM
	LAC[SIXBIT/FNT/]↔DAC EXTION
	LAC FNTPPN↔DAC PPPN
	CALL(<DEFONT+1>)
CCONT4:	LAC 1,FONT↔CALL(SETFNT)
CCONT3:	LAC 1,CHAR↔CALL(PRINT)
CCONT2:	POP  P,COL↔POP  P,ROW	;RESTORE XGP-BEAM POSITION.
CCONT:	SOSLE -1(P)↔GO CLOOP
	SUB P,[XWD 3,3]
	GO ILOOP

;EXECUTE III CONTROL OPERATIONS.
XCTRL:	TRNN IIIWRD,04↔GO[CAR 1,IIIWRD↔DAC 1,PC↔GO LOOP]  ;JUMP.
	TRNE IIIWRD,40↔GO LOOP			;SAVE A NOP HERE
	AOS 1,PC	;JSR
	HRLI 1,20
	CAR 2,IIIWRD
	CAMLE 2,OLD44
	CAML 2,BUFEND↔GO[ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔	GO RET]
	DAC 1,(2)↔DAC 2,PC
	GO ILOOP
	;EXECUTE VECTORS.
XVECTR:	TRNN IIIWRD,4
	GO [TRNN IIIWRD,10	;SHORT VECTOR OR TSS
	    GO SVECT		;SHORT VECTOR
	    GO ILOOP]		;TSS
	LDB [POINT 11,IIIWRD,10]↔ROT -13↔DAC X		;X FIELD.
	LDB [POINT 11,IIIWRD,21]↔ROT -13↔DAC Y		;Y FIELD
	LDB [POINT  3,IIIWRD,24]↔SKIPE↔DAC IIIBRT	;BRIGHTNESS
	LDB [POINT  3,IIIWRD,27]↔SKIPE↔DAC IIISIZ	;CHR SIZE
	LDB 1,[POINT 3,IIIWRD,31]↔CALL(VECTOR)		;OP CODE.
	GO ILOOP

SVECT:	PUSH P,IIIWRD				;SAVE III COMMAND.
	LDB [POINT 7,IIIWRD,06]↔ROT -7↔ASH -4↔DAC X	;X FIELD.
	LDB [POINT 7,IIIWRD,13]↔ROT -7↔ASH -4↔DAC Y	;Y FIELD.
	LDB 1,[POINT 2,IIIWRD,15]↔CALL(VECTOR)		;OP CODE.
	POP P,IIIWRD				;RESTORE III COMMAND.
	LDB [POINT 7,IIIWRD,22]↔ROT -7↔ASH -4↔DAC X	;X FIELD.
	LDB [POINT 7,IIIWRD,29]↔ROT -7↔ASH -4↔DAC Y   	;Y FIELD.
	LDB 1,[POINT 2,IIIWRD,31]↔CALL(VECTOR)		;OP CODE.
	GO ILOOP

VECTOR:	SETO↔TRNE 1,2↔SETZ		;SKIP ON VISIBLE VECTOR.
	TRNE 1,4↔GO .+3			;SKIP ON RELATIVE VECTOR.
 	ADD X,XBEAM↔ADD Y,YBEAM
	DAC X,XBEAM↔DAC Y,YBEAM
	MOVN R,Y↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW	;Y INTO ROW.
	LAC  C,X↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL	;X INTO COL.
	TRNE 1,1↔GO VPOINT		;SKIP NOT POINT VECTOR.
	LAC 2,ROW↔LAC 3,COL		;FROM OLD XGP BEAM POSITION.
	DAC R,ROW↔DAC C,COL		;SAVE NEW XGP BEAM POSITION.
	SKIPE↔CALL(MKSEG0)↔POP0J	;PLOT VECTOR - POP STACK.

;PLOT A DOT 3 BY 3.
VPOINT:	SOS R↔DAC R,ROW↔SOS C↔DAC C,COL	;SAVE NEW XGP BEAM POSITION.
	CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
	SETO↔DOT(R,C)↔AOS C↔DOT(R,C)

	LAC R,ROW↔LAC C,COL↔ADDI R,1
	CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
	SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)

	LAC R,ROW↔LAC C,COL↔ADDI R,2
	CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
	SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)↔POP0J

DECLARE{XBEAM,YBEAM,IIIBRT,IIISIZ}
CHRWID:	0↔8↔12↔14↔16↔24↔32↔48		;III CHARACTER WIDTHS.
ENDR IIISIM;2/8/73(TVR)8/21/73(BGB)----------------------------------
DELTA:	0
SUBR(VIDEO)
COMMENT .-----------------------------------------------------------.
COMMENT⊗ VIDEO FILE HEADER
	0	-1
	1	6	BITS PER BYTE.
	2	=48	WORDS PER ROW.
	3	R1
	4	R2
	5	C1
	6	C2
	7	-WC,,ADR ⊗
	ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2,R,C,TV}
;EXPECT AC-1 TO CONTAIN POINTER TO WORD ZERO OF VIDEO FILE IN CORE.
	LAC TV,1↔LAC 2(TV)↔DAC TVWIDTH#
	LAC 4(TV)↔SUB 3(TV)↔AOS↔DAC TVROWS#↔DZM TVROW0#
	LAC 6(TV)↔SUB 5(TV)↔AOS↔DAC TVCOLS#
	LAC R,ROW↔SKIPN DELTA↔GO[LAC TVROWS↔ASH 1↔SUB R,0↔GO .+1]
	TRZ R,3    		;UPPER LEFT MOST CORNER OF IMAGE.
	CAMLE R,ROWMAX↔POP0J    ;WHOLE VIDEO IMAGE BELOW THIS QPAGE.
	CAML R,ROWMIN↔GO L0     ;VIDEO IMAGE STARTS ON THIS QPAGE.
;VIDEO IMAGE STARTS BEFORE THIS QUARTER PAGE.
L00:	SUB R,ROWMIN↔ASH R,-2
	MOVM R,R↔DAC R,TVROW0#
	CAML R,TVROWS↔POP0J  ;WHOLE VIDEO IMAGE ABOVE THIS QPAGE.
	SUB R,TVROWS
	MOVMM R,TVROWS↔LAC R,ROWMIN
;VIDEO BYTE POINTER.
L0:	LAC P1,1(TV)		;BYTE SIZE.
	IORI P1,4400↔ROT P1,-=12
	HRR P1,7(TV)↔ADD P1,1	;ORIGIN OF VIDEO IN CORE.
	LAC TVROW0↔IMUL TVWIDTH↔ADD P1,0
;POINTER INTO XGP BUFFER.
	LAC C,COL↔SKIPN DELTA↔GO[LAC TVCOLS↔ASH 1↔SUB C,0↔GO .+1]
	HLLZ 1,XGP2D(C)↔ROT 1,6
	HRRI 1,@XGP2D(R)↔CDR P2,1
;J = COLUMNS/9			9 4-BIT XGP BYTES PER WORD.
	MOVEI J,=36↔IDIV J,1(TV)
	IMUL J,2(TV)↔IDIVI J,=9↔DAC J,JSAV#	;COLUMNS/9
	LAC I,TVROWS
L1:	DAC P2,P2SAV#↔LAC J,JSAV
L2:	SETZB 0,1↔SETZB 2,3↔MOVEI K,=9
L3:	ILDB Q,P1
	TRZ Q,3↔ROTC 0,4↔ROTC 2,4
	IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
	IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)↔SOJG K,L3
	CAIL C,=1728↔GO L4
	IORM 0,0*WWIDTH(P2)↔IORM 1,1*WWIDTH(P2)
	IORM 2,2*WWIDTH(P2)↔IORM 3,3*WWIDTH(P2)
L4:	AOS P2↔SOJG J,L2
	ADDI R,4↔CAMLE R,ROWMAX↔POP0J
	LAC P2,P2SAV↔ADDI P2,4*WWIDTH
	SOJG I,L1
	POP0J
;HALF TONE TABLE.
HTT:	6↔7↔7↔6↔	6↔6↔7↔6↔	6↔6↔6↔6↔	6↔6↔6↔6
	6↔6↔6↔4↔	4↔6↔6↔4↔	4↔6↔6↔4↔	4↔4↔6↔4
	4↔4↔4↔4↔	4↔4↔4↔4↔	0↔4↔4↔4↔	4↔4↔4↔0
	0↔4↔4↔0↔	0↔0↔4↔0↔	0↔0↔4↔0↔	0↔0↔0↔0
ENDR VIDEO;6/2/73(BGB)-----------------------------------------------
SUBR(INFILE)	INDIRECT FILE COMMAND "@".
COMMENT .-----------------------------------------------------------.

;FILE INITIALIZATION.
	INIT 1,17↔SIXBIT/DSK/↔0
	GO[FATAL(CAN'T INIT DSK)]
	CALL(GETFIL)↔POP0J
	LOOKUP 1,FILNAM↔GO[
	 	OUTSTR[ASCIZ/FILE NOT FOUND  -  /]
		POP P,1↔LAC 2,[POINT 7,4]↔MOVEI 3,=25
		ILDB 1↔CAIN";"↔GO $.+3↔IDPB 2↔SOJG 3,$.-4
		SETZ↔IDPB 2↔OUTSTR 4↔CRLF↔EXIT]
	
;EXPAND CORE WHEN NECESSARY.
	HLRE PPPN↔MOVMS↔DAC SIZE#		;WORD COUNT.
	IMULI =5↔DAC CHRCNT			;NEW CHARACTER COUNT.
	LAC 1,TXTORG↔ADD 1,SIZE↔DAP 1,JOBFF	;NEW TOP OF CORE.
	CDR 1,JOBFF↔CAMG 1,JOBREL↔GO .+3	;EXPAND CORE.
	CORE 1,↔GO[FATAL(<NO ROOM FOR TEXT.>)]

;INPUT THE FILE.
	CDR TXTORG↔HRLI 700↔DAC TXTPTR		;RESET TEXT POINTER.
	HLL PPPN↔DAC DUMARG			;DUMP MODE ARGUMENT.
	IN 1,DUMARG↔SKIPA↔HALT			;INPUT THE FILE.
	RELEASE 1,↔DZM CMODE			;ENTER TEXT MODE.

;SKIP OVER TEXT DIRECTORY IF IT EXISTS.
	LAC 2,TXTPTR
	LAC 3,[POINT 7,[ASCIZ/COMMENT ⊗   VALID/]]
	ILDB 0,2↔ILDB 1,3↔JUMPN 1,[
	  CAME 0,1↔POP0J↔GO .-2]
	CALL(GETCHR)
	CAIE 1,14↔GO .-2↔POP0J

	DUMARG:0↔0
ENDR INFILE;5/30/73(BGB)---------------------------------------------
;COMMAND EXECUTION.

;ABSOLUTE INVISIBLE VECTOR.
AI:	CALL(GETNUM)↔DAC 1,ROW				;I <row>, <col>;
	CALL(GETNUM)↔DAC 1,COL↔POP0J

;ABSOLUTE VISIBLE VECTOR.
AV:	CALL(GETNUM)↔DAC 1,4				;V <row>, <col>;
	CALL(GETNUM)↔DAC 1,5
	LAC 2,ROW↔LAC 3,COL				;FROM HITHER.
	DAC 3,ROW↔DAC 5,COL				; TO  YON.
	CALL(MKSEG0)↔POP0J
XRADIAL:
	CALL(GETNUM)↔DAC 1,5↔FLOAT 5,↔DAC 5,4
	CALL(GETNUM)↔DAC 1,3↔FLOAT 3,↔DAC 3,2
	FMP 2,SINE↔MOVNS 2↔FIXX 2,↔ADD 2,ROW
	FMP 4,SINE↔MOVNS 4↔FIXX 4,↔ADD 4,ROW
	FMP 3,COSINE↔FIXX 3,↔ADD 3,COL
	FMP 5,COSINE↔FIXX 5,↔ADD 5,COL
	CALL(MKSEG0)↔POP0J

XXSCAL:	CALL(REALIN)↔DAC SCALEX↔DAC SCALEY		;X <scale> ;
	FMPR[1024.]↔FIXX↔DAC IIIDX↔DAC IIIDY↔POP0J
YYSCAL:	CALL(REALIN)↔DAC SCALEY				;Y <scale> ;
	FMPR[1024.]↔FIXX↔DAC IIIDY↔POP0J
XROTAT:	CALL(READARC)↔DAC ROTDEL			;O <angle> ;
	SETQ(SINE,{SIN,ROTDEL})
	SETQ(COSINE,{COS,ROTDEL})↔POP0J
XLOCUS:	CALL(REALIN)↔FADR[630.0]↔FIXX↔DAC COL		;L <X>, <Y>;
	CALL(REALIN)↔FSBR[950.0]↔FIXX↔MOVNM ROW↔POP0J
XSETPAGE: CALL(REALIN)↔FIXX↔MOVMM PAGENO↔POP0J		;P <page number>;
XHEAVY:	CALL(REALIN)↔FIXX↔MOVMM HEAVY↔POP0J		;H <THICKNESS>;
HEAVY:	0
SUBR(SQRT,X)
COMMENT .-----------------------------------------------------------.
;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
	A←0 ↔ B←←1 ↔ C←2
	MOVM B,X↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
	ASHC B,-=27↔SUBI B,201	;GET EXPONENT IN B, FRACTION IN C.
	ROT B,-1		;CUT EXP IN HALF, SAVE ODD BIT
	HRRM B,L↔LSH B,-=35	;USE THAT ODD BIT.
	ASH C,-10↔FSC C,177(B)	;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
	MOVEM C,A
	FMP C,[0.8125↔0.578125](B)
	FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
	MOVE B,A
	FDV B,C↔FAD C,B↔FSC C,-1
	FDV A,C↔FADR A,C
     L: FSC A,0↔MOVE 1,A↔POP P,2
	POP1J
ENDR SQRT;--------------------------------------------------------

BEGIN SINCOS		;SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
	A←←1 ↔ B←2 ↔ C←3
↑COS:	SKIPA A,-1(P)
↑SIN:	SKIPA A,-1(P)
	FADR  A,HALFPI			;COS(X) = SIN(X+π/2).
	MOVM B,A↔CAMG B,[17B5]↔POP1J	;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
	FDVR B,HALFPI
	LAC C,B↔FIX C,233000
	CAILE C,3↔GO[TRZ C,3↔FSC C,233
	FSBR B,C↔GO .-3]		;MODULO 2π.
	GO .+1(C)↔GO .+4↔JFCL↔GO[
	FSBRI B,(2.0)↔MOVNS B↔GO .+2]	;SIN(X+π)=SIN(-X)
	FSBRI B,(4.0)			;SIN(X+2π)=SIN(X)
	SKIPGE A↔MOVNS	B		;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
	DAC B,C↔FMPR B,B	
	LAC A,[164475536722]↔FMP A,B
	FAD A,[606315546346]↔FMP A,B
	FAD A,[175506321276]↔FMP A,B
	FAD A,[577265210372]↔FMP A,B
	FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI:	201622077325↔LIT ;PI/2
BEND;-------------------------------------------------------------
SUBR(REALIN)
COMMENT .-----------------------------------------------------------.
;<EXPR>		::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM>		::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY>	::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
	CALL(TERM)
	CAIN 1,"+"↔GO[
		PUSH P,0↔CALL(TERM)↔FADR 0,(P)
		SUB P,[XWD 1,1]↔GO REALIN+1]
	CAIN 1,"-"↔GO[
		PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
  	     	SUB P,[XWD 1,1]↔GO REALIN+1]
	POP0J↔POP0J
TERM:	CALL(PRIMARY)
TERM2:	CAIN 1,"*"↔GO[
		PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
		SUB P,[XWD 1,1]↔GO TERM2]
	CAIN 1,"/"↔GO[
		PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
		SUB P,[XWD 1,1]↔GO TERM2]
	POP0J
;BEGIN REALIN	; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION.	AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER.		AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0:	CALL(GETCHR)
	CAIN 1," "↔GO .-2
	CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
	CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
	      GETRET: CALL(GETCHR)↔GO L3]
	CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
		      CAIN 1,")"↔GO GETRET
		      OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔		      POP0J]
	SKIPA
L1:	CALL(GETCHR)
	CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
	CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
	CAIL 1,"0"↔CAILE 1,"9"↔GO L2
	JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
	ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2:	FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3:	SKIPE 3↔MOVNS↔POP0J
ENDR REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------

SUBR(READARC)
COMMENT .-----------------------------------------------------------.
	CALL(REALIN)
	JUMPL[CAMG[6.3]↔FMPR[0.0174533]↔POP0J]
	CAML[6.3]↔FMPR[0.0174533]
	POP0J
ENDR READARC;--------------------------------------------------------
SUBR(DPYDOT,X,Y)	;DISPLAY A DOT.
COMMENT .-----------------------------------------------------------.
;PLACE A DOT AT LOCUS (X,Y).
;DILATION, ROTATION, TRANSLATION, & CLIP.
	ACCUMULATORS{R,C}
	LAC R,X↔LAC C,Y
	FMP R,SCALEY↔LAC 0,R		;DILATION.
	FMP C,SCALEX↔LAC 1,C
	FMP 0,SINE↔FMP R,COSINE		;ROTATION.
	FMP 1,SINE↔FMP C,COSINE
	FADR R,1↔FSBR C,0↔MOVNS R
	FIXX R,↔ADD R,ROW		;TRANSLATION.
	FIXX C,↔ADD C,COL
	CAMGE R,ROWMIN↔POP2J		;CLIP.
	CAMLE R,ROWMAX↔POP2J
	SKIPGE C↔POP2J
	CAILE C,=1728
	SETO↔DOT(R,C)↔POP2J		;DISPLAY.
ENDR DPYDOT;5/29/73(BGB)---------------------------------------------

SUBR(MKSEG3)
COMMENT .-----------------------------------------------------------.
	R←←2 ↔ C←←3
	EXCH R,C
	FMP R,SCALEY↔LAC 0,R		;DILATION.
	FMP C,SCALEX↔LAC 1,C
	FMP 0,SINE↔FMP R,COSINE		;ROTATION.
	FMP 1,SINE↔FMP C,COSINE
	FADR R,1↔FSBR C,0↔MOVNS R
	FIXX R,↔ADD R,ROW		;TRANSLATION.
	FIXX C,↔ADD C,COL
	R←←4 ↔ C←←5
	EXCH R,C
	FMP R,SCALEY↔LAC 0,R		;DILATION.
	FMP C,SCALEX↔LAC 1,C
	FMP 0,SINE↔FMP R,COSINE		;ROTATION.
	FMP 1,SINE↔FMP C,COSINE
	FADR R,1↔FSBR C,0↔MOVNS R
	FIXX R,↔ADD R,ROW		;TRANSLATION.
	FIXX C,↔ADD C,COL↔GO MKSEG0
ENDR MKSEG3;_________________________________________________________

SUBR(XBOX)
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{X1,Y1,X2,Y2}
	CALL(REALIN) ↔ MOVMM PDX# ↔ MOVNM NDX# ↔ CAIE 1,";"
	CALL(REALIN) ↔ MOVMM PDY# ↔ MOVNM NDY# 
	LAC X1,NDX↔LAC Y1,NDY↔LAC X2,NDX↔LAC Y2,PDY↔CALL(MKSEG3) ;WEST.
	LAC X1,PDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;EAST.
	LAC X1,NDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH.
	LAC X1,NDX↔LAC Y1,PDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;NORTH.
	POP0J
ENDR XBOX
END SA